home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / mu / mu-bbdb.el.z / mu-bbdb.el
Encoding:
Text File  |  1998-05-21  |  3.9 KB  |  130 lines
  1. ;;; mu-bbdb.el --- `attribution' function for mu-cite with BBDB.
  2.  
  3. ;; Copyright (C) 1996 Shuhei KOBAYASHI
  4.  
  5. ;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
  6. ;; Version: $Id: mu-bbdb.el,v 3.3 1996/12/10 11:57:23 shuhei-k Exp $
  7.  
  8. ;; This file is part of tl (Tiny Library).
  9.  
  10. ;; This program is free software; you can redistribute it and/or
  11. ;; modify it under the terms of the GNU General Public License as
  12. ;; published by the Free Software Foundation; either version 2, or (at
  13. ;; your option) any later version.
  14.  
  15. ;; This program is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with this program; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;;  - How to use
  28. ;;    1. bytecompile this file and copy it to the apropriate directory.
  29. ;;    2. put the following lines to your ~/.emacs:
  30. ;;        (require 'tl-misc)
  31. ;;        (call-after-loaded 'mu-cite
  32. ;;                   (function
  33. ;;                    (lambda ()
  34. ;;                      (require 'mu-bbdb)
  35. ;;                      )))
  36.  
  37.  
  38. ;;; Code:
  39.  
  40. (require 'mu-cite)
  41. (if (module-installed-p 'bbdb)
  42.     (require 'bbdb))
  43.  
  44. (defvar mu-bbdb-load-hook nil
  45.   "*List of functions called after mu-bbdb is loaded.")
  46.  
  47. ;;; @@ prefix and registration using BBDB
  48. ;;;
  49.  
  50. (defun mu-cite/get-bbdb-prefix-method ()
  51.   (or (mu-cite/get-bbdb-attr (mu-cite/get-value 'address))
  52.       ">")
  53.   )
  54.  
  55. (defun mu-cite/get-bbdb-attr (addr)
  56.   "Extract attribute information from BBDB."
  57.   (let ((record (bbdb-search-simple nil addr)))
  58.     (and record
  59.          (bbdb-record-getprop record 'attribution))
  60.     ))
  61.  
  62. (defun mu-cite/set-bbdb-attr (attr addr)
  63.   "Add attribute information to BBDB."
  64.   (let* ((bbdb-notice-hook nil)
  65.          (record (bbdb-annotate-message-sender
  66.                   addr t
  67.               (bbdb-invoke-hook-for-value
  68.                bbdb/mail-auto-create-p)
  69.           t)))
  70.     (if record
  71.         (progn
  72.           (bbdb-record-putprop record 'attribution attr)
  73.           (bbdb-change-record record nil))
  74.       )))
  75.  
  76. (defun mu-cite/get-bbdb-prefix-register-method ()
  77.   (let ((addr (mu-cite/get-value 'address)))
  78.     (or (mu-cite/get-bbdb-attr addr)
  79.         (let ((return
  80.            (read-string "Citation name? "
  81.                 (or (mu-cite/get-value 'x-attribution)
  82.                 (mu-cite/get-value 'full-name))
  83.                 'mu-cite/minibuffer-history)
  84.            ))
  85.       (if (and (not (string-equal return ""))
  86.                    (y-or-n-p (format "Register \"%s\"? " return)))
  87.           (mu-cite/set-bbdb-attr return addr)
  88.         )
  89.       return))))
  90.  
  91. (defun mu-cite/get-bbdb-prefix-register-verbose-method ()
  92.   (let* ((addr (mu-cite/get-value 'address))
  93.          (attr (mu-cite/get-bbdb-attr addr))
  94.      (return (read-string "Citation name? "
  95.                   (or attr
  96.                   (mu-cite/get-value 'x-attribution)
  97.                   (mu-cite/get-value 'full-name))
  98.                   'mu-cite/minibuffer-history))
  99.      )
  100.     (if (and (not (string-equal return ""))
  101.              (not (string-equal return attr))
  102.          (y-or-n-p (format "Register \"%s\"? " return))
  103.          )
  104.     (mu-cite/set-bbdb-attr return addr)
  105.       )
  106.     return))
  107.  
  108. (or (assoc 'bbdb-prefix mu-cite/default-methods-alist)
  109.     (setq mu-cite/default-methods-alist
  110.           (append mu-cite/default-methods-alist
  111.                   (list
  112.                    (cons 'bbdb-prefix
  113.                          (function mu-cite/get-bbdb-prefix-method))
  114.                    (cons 'bbdb-prefix-register
  115.                          (function mu-cite/get-bbdb-prefix-register-method))
  116.                    (cons 'bbdb-prefix-register-verbose
  117.                          (function
  118.                           mu-cite/get-bbdb-prefix-register-verbose-method))
  119.                    ))))
  120.  
  121.  
  122. ;;; @ end
  123. ;;;
  124.  
  125. (provide 'mu-bbdb)
  126.  
  127. (run-hooks 'mu-bbdb-load-hook)
  128.  
  129. ;;; mu-bbdb.el ends here
  130.